home *** CD-ROM | disk | FTP | other *** search
/ Scene 96 / Scene 96 International Edition (Zyklop Software) (Disc 2) (1997).iso / misc / coding / onenssrc / part2.pas < prev    next >
Pascal/Delphi Source File  |  1996-01-17  |  12KB  |  556 lines
  1. unit Part2;
  2.  
  3. interface
  4.  
  5. uses
  6.     zipvga, crt, fastsine, oneres;
  7.  
  8. procedure Run;
  9.  
  10. implementation
  11.  
  12. (*const
  13.     oldlscpal:array[0..383] of byte=(
  14.         0,0,0,48,48,48,1,0,43,1,3,43,2,5,44,2,7,44,3,9,45,4,11,46,5,13,47,6,15,48,
  15.         7,17,49,8,19,50,9,21,51,10,22,52,11,24,52,12,26,54,13,28,54,14,30,56,15,32,
  16.         56,16,34,58,17,34,58,17,36,58,18,38,60,19,40,60,20,42,62,21,44,62,10,31,0,
  17.         11,31,0,11,31,1,11,32,1,12,32,1,12,32,2,12,33,2,13,33,2,14,33,3,15,33,3,15,
  18.         34,3,15,34,4,15,35,4,16,35,4,16,35,5,16,36,5,17,36,5,17,36,6,18,37,6,18,38,
  19.         7,19,38,8,20,39,8,20,40,9,21,40,10,22,41,10,22,42,11,23,42,12,24,43,12,24,
  20.         44,13,25,44,14,25,45,14,26,46,15,27,46,16,27,47,17,28,47,18,28,48,19,29,49,
  21.         19,30,49,20,30,50,21,31,51,21,32,51,22,32,52,23,33,53,23,34,53,24,34,54,25,
  22.         35,55,25,36,55,26,36,56,27,37,57,27,38,57,27,39,57,27,41,57,27,42,57,27,43,
  23.         57,27,44,57,27,45,57,27,46,57,27,47,57,27,49,57,27,50,57,27,51,57,27,52,57,
  24.         27,53,57,27,55,57,27,56,57,27,57,57,27,58,57,27,58,57,26,58,57,25,58,57,24,
  25.         58,56,23,58,55,22,58,54,20,58,53,19,58,51,18,58,50,17,58,50,16,58,49,15,58,
  26.         48,14,58,47,13,58,46,12,58,45,11,58,44,11,58,44,10,58,43,10,58,42,9,57,41,
  27.         8,57,40,8,56,39,7,56,38,6,55,37,5,55,35,4,54,33,4,54,31,2,32,32,32,63,63,63,
  28.         63,63,63,63,63,63,63,63,63,48,48,48,63,63,63,63,63,63);*)
  29.  
  30. type
  31.     TrigTable = array[0..511] of integer;
  32.  
  33. const
  34.     firstframe = 1024;
  35.     lastframe = firstframe+1024;
  36.  
  37. var
  38.     lscpal : array[0..383] of byte;
  39.     ISin, ICos : TrigTable;
  40.     Y320 : array[0..255] of word;
  41.     scr, mp, mt : ^screen2;
  42.     i, j : word;
  43.     x, y, z, h : integer;
  44.     xv, yv, zv : integer;
  45.     wl : word;
  46.     fog, gray, p : palette;
  47.     start, stop, frame, fr : longint;
  48.     oldpal : palette absolute lscpal;
  49.     rng : array[0..319] of byte;
  50.     fper, fiso : longint;
  51.     quit : boolean;
  52.  
  53. function tcount : longint;
  54.  
  55. var
  56.     c, d : word;
  57.  
  58. begin
  59.     asm
  60.         mov ah, 0
  61.         int 26
  62.         mov c, cx
  63.         mov d, dx
  64.      end;
  65.     tcount := 256*c + d;
  66. end;
  67.  
  68. procedure Init;
  69.  
  70. var
  71.     i : word;
  72.  
  73. begin
  74.     for i := 0 to 511 do
  75.      begin
  76.         ISin[i] := round(256*sin(i*pi/256));
  77.         ICos[i] := round(256*cos(i*pi/256));
  78.      end;
  79.     for i := 0 to 255 do
  80.      begin
  81.         Y320[i] := i*320;
  82.      end;
  83. end;
  84.  
  85. function maxi(a,b:word):word; assembler;
  86.  
  87. asm
  88.     mov ax, a
  89.     mov bx, b
  90.     cmp ax, bx
  91.     jg @dont
  92.     xchg ax, bx
  93.  @dont:
  94. end;
  95.  
  96.     function ncol(mc,n,dvd:integer):integer;
  97.  
  98.     var
  99.         loc:integer;
  100.  
  101.     begin
  102.         loc:=(mc+n-random(2*n)) div dvd; ncol:=loc;
  103.         if loc>128 then ncol:=128; if loc<5 then ncol:=5
  104.     end;
  105.  
  106.     procedure plasma(x1,y1,x2,y2:word);
  107.  
  108.     var xn,yn,dxy,p1,p2,p3,p4:word;
  109.  
  110.     begin
  111.         if (x2-x1<2) and (y2-y1<2) then exit;
  112.         p1:=mp^[y1*256 + x1]; p2:=mp^[y2*256 + x1]; p3:=mp^[y1*256 + x2];
  113.         p4:=mp^[y2*256 + x2]; xn:=(x2+x1) shr 1; yn:=(y2+y1) shr 1;
  114.         dxy:=5*(x2-x1+y2-y1) div 3;
  115.         if mp^[y1*256 + xn]=0 then mp^[y1*256 + xn]:=ncol(p1+p3,dxy,2);
  116.         if mp^[yn*256 + x1]=0 then mp^[yn*256 + x1]:=ncol(p1+p2,dxy,2);
  117.         if mp^[yn*256 + x2]=0 then mp^[yn*256 + x2]:=ncol(p3+p4,dxy,2);
  118.         if mp^[y2*256 + xn]=0 then mp^[y2*256 + xn]:=ncol(p2+p4,dxy,2);
  119.         mp^[yn*256 + xn]:=ncol(p1+p2+p3+p4,dxy,4);
  120.         plasma(x1,y1,xn,yn); plasma(xn,y1,x2,yn);
  121.         plasma(x1,yn,xn,y2); plasma(xn,yn,x2,y2);
  122.     end;
  123.  
  124. procedure DrawField (var mp, mt : screen2; xp, yp, zobs, dir : integer; fs, dist, wl : byte; var scr : screen2);
  125.  
  126. (* mp : the array to get the voxels from, silly! :)
  127. ** xp, yp, zobs : xposition, yposition, z of observer
  128. ** dir : direction (in degrees of course)
  129. ** dist : rendering depth
  130. ** wl : water level
  131. ** scr : a 64k buffer for the drawing
  132. *)
  133.  
  134. var
  135.     z : integer;
  136.     ix, iy, x, y : integer;
  137.     iy1, iyp, ixp : integer;
  138.     s, csf, snf : integer;
  139.     mpc : integer;
  140.     i,j:integer;
  141.     oldc : byte;
  142.  
  143. begin
  144.     fillchar (rng, sizeof(rng), 200);
  145.  
  146.     {if Zobs < 64 then
  147.         zobs := 64;}
  148.  
  149.     dir := dir mod 512;
  150.     while dir < 0 do
  151.         inc(dir,512);
  152.     csf := ICos[dir];
  153.     snf := ISin[dir];
  154.  
  155.     {for iy := yp to yp + dist do}
  156.     for iy := yp + 8 to yp + dist do
  157.      begin
  158.         iy1 := 1 + ((iy - yp) SHL 1);
  159.         s := 4 + 300 div iy1;
  160.         for ix := xp + yp - iy to xp - yp + iy do
  161.          begin
  162.             ixp := xp + ((ix - xp)*csf + (iy - yp)*snf) shr 8;
  163.             {ixp := ixp mod 256;
  164.             while ixp < 0 do
  165.                 inc (ixp, 256);}
  166.              ixp := ixp and 255;
  167.             iyp := yp + ((iy - yp)*csf - (ix - xp)*snf) shr 8;
  168.             {iyp := iyp mod 256;
  169.             while iyp < 0 do
  170.                 inc (iyp, 256);}
  171.             iyp := iyp and 255;
  172.             x:=160 + 360*(ix - xp) div iy1;
  173.             if (x >= 0) and (x + s < 320) then
  174.              begin
  175.                 z := mp[(iyp mod 256)*256 + ixp mod 256];
  176.                 if @mt = @mp then
  177.                     mpc := {z div 16 + 16*((yp - iy + dist)*16 div dist)} z
  178.                 else
  179.                     {mpc := mt[(iyp mod 256)*256 + ixp mod 256] div 16 + 16*((yp - iy + dist)*16 div dist)};
  180.                     mpc := mt[iyp*256 + ixp];
  181.  
  182.                 mpc := mini(mini(255, mpc), mpc*((yp + fs - iy + dist)*16 div dist) div 16);
  183.  
  184.                 if (z < wl) and (zobs > wl) then
  185.                     z := wl;
  186.                 y := 100 + (zobs - z)*30 div iy1;
  187.                 if (y <= 199) and (y >= 0) then
  188.                     for j := x to x + s do
  189.                         if y < rng[j] then
  190.                             asm
  191.                                 les di, scr
  192.  
  193.                                 mov si, y
  194.                                 shl si, 1
  195.                                 add si, offset Y320
  196.                                 add di, ds:[si]
  197.                                 add di, j
  198.  
  199.                                 mov ax, mpc
  200.  
  201.                                 xor ch, ch
  202.                                 mov si, j
  203.                                 add si, offset rng
  204.                                 mov cl, [ds:si]
  205.                                 sub cx, y
  206.                                 inc cx
  207.  
  208.                              @LoopY:
  209.                                 mov es:[di], al
  210.                                 add di, 320
  211.  
  212.                                 dec cx
  213.                                 jnz @LoopY
  214.  
  215.                                 mov ax, y
  216.                                 mov ds:[si], al
  217.                              end;
  218.                         {begin
  219.                             for i:=y to rng[j] do
  220.                                 scr[Y320[i] + j] := mpc;
  221.                             rng[j] := y;
  222.                          end;}
  223.              end;
  224.          end;
  225.      end;
  226. end;
  227.  
  228. (*procedure DrawIso (var mp, mt : voxelarray; xp, yp, zp : integer; wl : byte; var scr : voxelarray);
  229.  
  230. var
  231.     i, j : word;
  232.     x0, y0 : integer;
  233.     x, y : word;
  234.     ex, ey : word;
  235.     f : word;
  236.     so : word;
  237.     c, z : word;
  238.  
  239. begin
  240.     fillchar (rng, sizeof(rng), 200);
  241.  
  242.     x0 := xp - 64;
  243.     y0 := yp - 64;
  244.  
  245.     while x0 < 0 do
  246.         inc (x0, 256);
  247.     while y0 < 0 do
  248.         inc (y0, 256);
  249.  
  250.     x0 := x0 mod 256;
  251.     y0 := y0 mod 256;
  252.  
  253.     for j := 63 downto 0 do
  254.         for i := 127 downto 0 do
  255.          begin
  256.             c := mp[((j*2 + y0) mod 256)*256 + (i + x0) mod 256];
  257.             if c > 254 then
  258.                 c := 254;
  259.  
  260.             z := maxi(c, wl);
  261.  
  262.             x := 159 + i - j*2;
  263.             y := 73 + i div 2 + j - z div 8;
  264.  
  265.             {c := mt[((j*2 + y0) mod 256)*256 + (i + x0) mod 256];}
  266.             c := c div 16 + 16*mini(15, mini(j div 4, i div 8));
  267.  
  268.             if (i = 63) and (j = 31) then
  269.              begin
  270.                 if y < rng[x] then
  271.                     rng[x] := y;
  272.  
  273.                 y := 73 + i div 2 + j - zp div 8;
  274.  
  275.                 if y <= rng[x] then
  276.                  begin
  277.                     ex := x;
  278.                     ey := y;
  279.                  end
  280.                 else
  281.                  begin
  282.                     ex := 0;
  283.                     ey := 200;
  284.                  end;
  285.              end
  286.             else if y < rng[x] then
  287.              {begin
  288.                 for f := y to rng[x] do
  289.                     scr[Y320[f] + x] := c;
  290.                 rng[x] := y;
  291.              end;}
  292.              asm
  293.                 les di, scr
  294.  
  295.                 mov si, y
  296.                 shl si, 1
  297.                 add si, offset Y320
  298.                 add di, ds:[si]
  299.                 add di, x
  300.  
  301.                 mov ax, c
  302.  
  303.                 xor ch, ch
  304.                 mov si, x
  305.                 add si, offset rng
  306.                 mov cl, [ds:si]
  307.                 sub cx, y
  308.                 inc cx
  309.  
  310.              @LoopY:
  311.                 mov es:[di], al
  312.                 add di, 320
  313.  
  314.                 dec cx
  315.                 jnz @LoopY
  316.  
  317.                 mov ax, y
  318.                 mov ds:[si], al
  319.              end;
  320.          end;
  321.  
  322.     if ey < 200 then
  323.         scr[Y320[ey] + ex] := 255;
  324. end;*)
  325.  
  326. procedure Run;
  327.  
  328. begin
  329.     new (scr);
  330.  
  331.     InitB;
  332.  
  333.     {initvga;}
  334.     {brightness (0, 63);}
  335.     (*for i := 0 to 63 do
  336.      begin
  337.         p[i][0] := 0;
  338.         p[i][1] := 0;
  339.         p[i][2] := i;
  340.      end;
  341.     for i := 64 to 127 do
  342.      begin
  343.         p[i][0] := i - 64;
  344.         p[i][1] := 0;
  345.         p[i][2] := 127 - i;
  346.      end;
  347.     for i := 128 to 255 do
  348.      begin
  349.         p[i][0] := (255 - i) div 2;
  350.         p[i][1] := 0;
  351.         p[i][2] := 0;
  352.      end;
  353.     fillchar (p[255], 3, 63);
  354.     setpalette (p);*)
  355.     (*for i := 0 to 255 do
  356.      begin
  357.         fog[i][0] := 32 - (i div 16 + 1)*2 + (i mod 16)*(i div 16 + 1) div 6;
  358.         fog[i][1] := 32 - (i div 16 + 1)*2 + (i mod 16)*(i div 16 + 1) div 8;
  359.         fog[i][2] := 32 - (i div 16 + 1)*2;
  360.      end;*)
  361.  
  362.     (*for i := 0 to 383 do
  363.         lscpal[i] := i*(i mod 3)*32 div 384;
  364.     for i := 0 to 255 do
  365.         for j := 0 to 2 do
  366.          begin
  367.             x := oldpal[((i*24) mod 384) div 3, j]{ + oldpal[((mini(i + 1, 255)*24) mod 384) div 3, j]) shr 1};
  368.             fog[i, j] := 32 - (i div 16 + 1)*2 + x*(i div 16 + 1) div 16;
  369.          end;*)
  370.  
  371.     (*for i := 0 to 255 do
  372.         for j := 0 to i - 1 do
  373.             if (p[i][0] = p[j][0]) and (p[i][2] = p[j][2]) then
  374.                 p[j, 0] := 255 - p[j, 0];*)
  375.  
  376.     (*savepalette ('Foggy.pal', p);
  377.     compilepalette ('foggy', 'foggypalette');*)
  378.  
  379.     (*fog[255][0] := 63;
  380.     fog[255][1] := 63;
  381.     fog[255][2] := 0;
  382.  
  383.     setpalette (fog);
  384.  
  385.     for i := 0 to 255 do
  386.         vscr[i div 16, i mod 16] := i;
  387.  
  388.     readkey;*)
  389.  
  390.     {for i := 0 to 254 do
  391.         for j := 0 to 2 do
  392.             gray[i, j] := i div 4;}
  393.     (*for i := 0 to 254 do
  394.         for j := 0 to 2 do
  395.             gray[i, j] := (oldpal[i div 2, j] + oldpal[(i + 1) div 2, j]) shr 1;
  396.  
  397.     gray[255][0] := 63;
  398.     gray[255][1] := 0;
  399.     gray[255][2] := 0;
  400.  
  401.     setpalette (gray);*)
  402.  
  403.     init;
  404.     new (mp);
  405.     {x := 0;
  406.     for i := 0 to 255 do
  407.         for j := 0 to 255 do
  408.          begin
  409.             (*mp^[j*256 + i] := (bsin(i*256 div 45 + bcos(j)*64 div 45) + bsin(j*512 div 45)) div 2;*)
  410.             mp^[j*256 + i] := (bsin(i*256 div 45 + j*256 div 45) + bcos(i*512 div 45) div 2 +
  411.                     bcos(j*256 div 45 + i*256 div 45) + bcos(j*384 div 45) div 2) div 3;
  412.             x := maxi(x, mp^[j*256 + i] + 1);
  413.          end;
  414.     savepic2 ('voxel.mp', mp^);}
  415.     fetch ('voxel.mp');
  416.     blockread (lf, mp^, 32768);
  417.     blockread (lf, mp^[32768], 32768);
  418.  
  419.     if maxavail >= sizeof(mt^) then
  420.      begin
  421.         new (mt);
  422.  
  423.         (*{for i := 0 to 255 do
  424.             for j := 0 to 255 do
  425.                 mt^[j*256 + i] := (mp^[j*256 + i] - mp^[j*256 + i - 1])*16 + 128;}
  426.         for i := 0 to 65535 do
  427.             mt^[i] := ((random((mp^[i] - mp^[i-1])*16) + 128)*mp^[i]) div 256;
  428.             {mt^[i] := (bsin(i*123 div 45)*mp^[i]) div 256;}*)
  429.         fetch ('voxel.mt');
  430.         blockread (lf, mt^, 32768);
  431.         blockread (lf, mt^[32768], 32768);
  432.      end
  433.     else
  434.         mt := mp;
  435.     (*savepic2 ('voxel.mt', mt^);*)
  436.  
  437.     (*plasma (0, 0, 256, 256);*)
  438.  
  439.     (*for i := 0 to 199 do
  440.         moveword (mp^[(i*50 shr 6)*256], vscr[i], 128);
  441.  
  442.     readkey;
  443.  
  444.     for i := 0 to 199 do
  445.         moveword (mt^[(i*50 shr 6)*256], vscr[i], 128);
  446.  
  447.     readkey;*)
  448.  
  449.     {if mt <> mp then
  450.      begin
  451.         for i := 0 to 199 do
  452.             moveword (mt^[i*256], vscr[i], 128);
  453.         readkey;
  454.      end;}
  455.  
  456.     {setpalette (fog);}
  457.  
  458.     x := 0;
  459.     y := 0;
  460.     z := 255;
  461.     xv := 0;
  462.     yv := 4;
  463.     zv := 0;
  464.     frame := 0;
  465.     wl := 63;
  466.  
  467.     fper := 0;
  468.     fiso := 0;
  469.  
  470.     quit := false;
  471.  
  472.     {start := tcount;}
  473.     (*repeat
  474.     until tcount mod 144 = 0;*)
  475.     repeat
  476.         getpos;
  477.         fr := track*256 + 4*row;
  478.  
  479.         if fr < firstframe + 256 then
  480.             brightness ((fr - firstframe) div 4, 63 - (fr - firstframe) div 4)
  481.         else if fr > lastframe - 64 then
  482.             brightness (lastframe - fr, 0);
  483.  
  484.         filldword (scr^, 16000, 0);
  485.  
  486.         h := ISin[(frame and 255)*2] div 2;
  487.  
  488.         {if (tcount div 144) mod 2 = 0 then
  489.          begin}
  490.             drawfield (mp^, mt^, x, y, z, h, 32, 72, wl, scr^);
  491.             {inc (fper);
  492.          end
  493.         else
  494.          begin
  495.             drawiso (mp^, mt^, x, y, z, wl, scr^);
  496.             inc (fiso);
  497.          end;}
  498.  
  499.         if trapretrace then
  500.             retrace;
  501.         {setrgb (0, 0, 0, 0);}
  502.         movedword (scr^, vscr, 16000);
  503.         {setrgb (0, 31, 31, 31);}
  504.  
  505.         if z < 128 + maxi(mp^[y*256 + x], mp^[(y + 10)*256 + x]) then
  506.             inc (zv)
  507.         else
  508.             if zv > -4 then
  509.                 dec (zv);
  510.  
  511.         if h < 0 then
  512.             h := h + 512;
  513.  
  514.         xv := ISin[h and 511] div 64;
  515.         yv := ICos[h and 511] div 64;
  516.  
  517.         if mp^[256*(10 + y) + x] - 1 > mp^[256*(10 + y) + x + xv + 1] then
  518.             inc (xv)
  519.         else if mp^[256*(10 + y) + x] - 1 > mp^[256*(10 + y) + x - xv - 1] then
  520.             dec (xv);
  521.  
  522.         frame := (frame + 1) mod 1024;
  523.         {if frame < 1024 then
  524.             inc (frame);}
  525.  
  526.         {inc(mp^[y*256 + x]);}
  527.  
  528.         x := (x + xv) mod 256;
  529.         y := (y + yv) mod 256;
  530.         z := z + zv;
  531.  
  532.         {if keypressed then
  533.             case readkey of
  534.                 '+', '=' : if wl < 255 then
  535.                     inc (wl);
  536.                 '-' : if wl > 0 then
  537.                     dec(wl);
  538.                 #27 : quit := true;
  539.              end;}
  540.     until keypressed or (fr >= lastframe){ and (tcount mod 144 = 0)};
  541.     {stop := tcount;}
  542.  
  543.     {closevga;}
  544.  
  545.     {writeln ('FPS = ', frame/((stop - start)/18.2):10:10);}
  546.  
  547.     (*writeln ('Perspective: ', fper);
  548.     writeln ('Isometric:   ', fiso);*)
  549.  
  550.     if mp <> mt then
  551.         dispose (mt);
  552.     dispose (mp);
  553.     dispose (scr);
  554. end;
  555.  
  556. end.